home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Mode Examples / Pascal-Example.p < prev    next >
Encoding:
Text File  |  2000-10-30  |  9.9 KB  |  308 lines
  1. { Pascal-Example.p                                                           }
  2. {                                                                            }
  3. { Included in the Alpha distribution as an example of the Pasc mode          }
  4. {                                                                            }
  5. { source of original document:                                               }
  6. {                                                                            }
  7. { http://pascal-central.com/                                                 }
  8.  
  9. { MakeBHT.p                                                                  }
  10. {                                                                            }
  11. { Make Balloon Compiler Text                                                 }
  12.  
  13. { Works in conjunction with the Peter M Lewis's excellent Balloon Help       }
  14. { Compiler for Code Warrior.  It's something I whipped up using Code         }
  15. { Warrior's 9 Pascal compiler to take all the menus and dialogs in a resedit }
  16. { (rsrc) or Application and spit them out in a CW text file in the same      }
  17. { format as Peter's Ballon Help Compiler requires.  It's a simple 68K        }
  18. { application and there won't be a fat version cause it's not worth writing  }
  19. { (like 10 seconds vs 2 seconds to rip through an application with 42 menus  }
  20. { and about 200 dialogs).                                                    }
  21. {                                                                            }
  22. { This is a FreeWare Application and may be freely distributed and used.     }
  23. {                                                                            }
  24. { Copyright © 1996 Milton Aupperle                                           }
  25. { <aupperlm@cadvision.com>                                                   }
  26.  
  27. program MakeBHT;
  28. uses 
  29.     ConditionalMacros, MixedMode, Types, QuickDraw, fp, fenv, fixmath,
  30.     Strings, Events, Windows, PictUtils, GestaltEqu, AERegistry, AEObjects,
  31.     AEPackObject, Aliases, AppleScript, ASRegistry, OSAComp, OSA,
  32.     OSAGeneric, Dialogs, Fonts, DiskInit, TextEdit,Traps, Devices, Memory,
  33.     SegLoad, FSM, Displays, Translation, TranslationExtensions, {For
  34.     Macintosh Easy open} Scrap, ToolUtils, OSUtils, Menus, Palettes,
  35.     Processes, PPCToolbox, EPPC, ColorPicker, Notification, AppleEvents,
  36.     QDOffscreen, Folders, Controls, TextUtils, script, Packages, Editions,
  37.     Lists, files, StandardFile, Resources, Printing, Sound, DeskBus, Video,
  38.     imageCompression, QuickTimeComponents, imageCodec, MoviesFormat,
  39.     Movies, MediaHandlers, AIFF, SoundInput, SoundComponents, Speech;
  40. {Standard UPI header stuff}
  41.  
  42. const
  43. var
  44.     OutVol, ApplResFile: Integer;
  45.     GlobalError: Integer;
  46. function NumToStr (num: double_t; NDig: Integer): Str255;
  47. begin
  48.     NumToStr := StringOf(Num:0:Ndig);
  49. end;
  50. procedure ShowError (Code: LongInt);
  51.     const
  52.         IsStop = 0;
  53.         IsCaution = 1;
  54.         IsNote = 2;
  55.         ErrorAlrtID = 1003;
  56.         IOErrStrID = 450;
  57.     var
  58.         S, S1: Str255;
  59.         Itemhit: Integer;
  60.         Abort: Boolean;
  61.  
  62.     function ALertResponse (WhichAlert, AlertType: Integer): Integer;
  63.         var
  64.             HAlrt: AlertTHndl;
  65.             X, Y: Integer;
  66.             Width, Height: Integer;
  67.         begin
  68.             ALertResponse := 1;
  69.             HAlrt := AlertTHndl(GetResource('ALRT', WhichAlert));
  70.             if HAlrt <> nil then
  71.                 begin
  72.                     with HAlrt^^.BoundsRect do
  73.                         begin
  74.                             Width := (Right - left);
  75.                             Height := (Bottom - Top);
  76.                         end;
  77.                     with Qd.SCREENBITS.BOUNDS do
  78.                         begin
  79.                             X := Left + (Right - Left - Width) div 2;
  80.                             Y := 50;{25 pixels below Menubar}
  81.                         end;
  82.                     SetRect(HAlrt^^.BoundsRect, X, Y, X + Width, Y + Height);
  83.                     ParamText(S, S1, '', '');
  84.                     case AlertType of
  85.                         IsStop: 
  86.                             ALertResponse := StopAlert(WhichAlert, nil);
  87.                         IsCaution: 
  88.                             ALertResponse := CautionAlert(WhichAlert, nil);
  89.                         IsNote: 
  90.                             ALertResponse := NoteAlert(WhichAlert, nil);
  91.                     end;
  92.                 end;
  93.         end;
  94.     begin
  95.         itemhit := SetVol(nil, OutVol);
  96.         UseResFile(ApplResFile);
  97.         if code <> NoErr then
  98.             sysbeep(1);
  99.         case Code of  {**Convert # to Message**}
  100.             NoErr: {Final message}
  101.                 Itemhit := 15;{Should be the last item in the strings}
  102.             -39, -36: 
  103.                 itemhit := 2;{Emty File,Data Miss, Blank Line Err}
  104.             -130: 
  105.                 itemhit := 3;{bad data in X or Y col error}
  106.             -33, -34, -194: 
  107.                 itemhit := 7;{FullDsk Err}
  108.             -44, -45, -46, -54, -61: 
  109.                 itemhit := 8;{Locked dsk/file Err}
  110.             -35, -43, -53, -192, -193: 
  111.                 itemhit := 9;{Nofindfolder}
  112.             -27: 
  113.                 itemhit := 13;{Unknown printing error}
  114.             -47, -49: 
  115.                 ItemHit := 14;{File already open}
  116.             otherwise
  117.                 Itemhit := 12;{SYS Error or unknown type error}
  118.         end;
  119.         SetCursor(Qd.Arrow);
  120.         S := '';
  121.         GetIndString(S1, IOErrStrID, itemhit);
  122.         if itemhit = 15 then
  123.             Abort := ALertResponse(ErrorAlrtID, isNote) > 0
  124.         else {}
  125.             if (itemhit = 12) and (Code > 0) then
  126.                 begin {System error}
  127.                     SysError(Code);
  128.                     ExitToShell;
  129.                 end
  130.             else
  131.                 begin
  132.                     S := Concat('Error# ', NumtoStr(Code, 0));
  133.                     if itemhit = 12 then
  134.                         SysError(Code)
  135.                     else
  136.                         Abort := ALertResponse(ErrorAlrtID, isStop) > 0;
  137.                 end;
  138.     end;
  139.  
  140. Procedure DisToBallons;
  141. const
  142.     CheckedC = Chr(CheckMark);
  143.     NoMarkC = chr(nomark);
  144. var
  145.     ThisMenu:MenuRef;
  146.     menuID,first,last:Integer;
  147.     ThisItem, firstitem, lastitem:Integer;
  148.     optType,TheItem,itemhit: Integer;
  149.     ItemHdl: Handle;
  150.     OptBox: rect;
  151.     S,S1,S2:Str255;
  152.     TheStatFlag:Integer;
  153.     TheDialog:Dialogptr;
  154.     theactualID: INTEGER;
  155.     theRType: ResType;
  156.     WatchCursor: Cursor;
  157.     hcurs: CursHandle;
  158.     Fout:Text;
  159.     TempResHandle:Handle;
  160.     FileInNum:Integer;
  161.     Where:Point;
  162.     typeList: SFTypeList;
  163.     Reply: SFReply;
  164.     AChar:Char;
  165. Begin
  166.     SetPt(Where, -1, -1);{Auto center the Open file dialog}
  167.     S := ' ';
  168.     TypeList[0] := 'APPL';
  169.     TypeList[1] := 'rsrc';
  170.     SFGetFile(Where, S, nil, 2, @TypeList, nil, Reply);
  171.     if Reply.Good then
  172.     begin
  173.         Hcurs := GetCursor(401);{Watch}
  174.         WatchCursor := Hcurs^^;
  175.         SetCursor(WatchCursor);
  176.         itemhit := SetVol(nil, Reply.vRefnum);
  177.         S := Reply.Fname;
  178.         FileInNum := OpenResFile(S);{The current resource is now MCC π or ƒ}
  179.         GlobalError := ResError;
  180.         if (GlobalError <> NoErr) or (FileInNum = -1) then
  181.         begin
  182.             if GlobalError = NoErr then
  183.                 GlobalError := -192;{Resource not found}
  184.             showerror(GlobalError);
  185.             Exit(DisToBallons);{Failed}
  186.         end;
  187.         S := concat(Reply.Fname,'.bh');
  188.         ReWrite(Fout,S);
  189.         UseResFile(FileInNum);
  190.         last := Count1Resources('MENU');
  191.         for menuID := 1 to last do
  192.         begin
  193.             TempResHandle := Get1IndResource('MENU', menuID);
  194.             if (TempResHandle <> nil) and (reserror = noerr) then
  195.             Begin
  196.                 GetResInfo(TempResHandle, theactualID, theRType, S);
  197.                 ReleaseResource(TempResHandle);
  198.                 ThisMenu := GetMenu(theactualID);
  199.                 lastitem := CountMItems(ThisMenu);
  200.                 S := concat('MENU ',NumtoStr(theactualID,0),' ',S);{should be MENU 80 name}
  201.                 Writeln(Fout,S);
  202.                 for ThisItem := 1 to lastitem do
  203.                 begin
  204.                     GetMenuItemText(ThisMenu, ThisItem, S);
  205.                     GetItemMark(ThisMenu,ThisItem,AChar);
  206.                     if AChar = NoMarkC then
  207.                         TheStatFlag := 1 + ord(S='-')
  208.                     else
  209.                         if AChar = CheckedC then
  210.                             TheStatFlag := 3
  211.                         else
  212.                             TheStatFlag := 4;{something else}
  213.                     S := concat(NumtoStr(ThisItem+TheStatFlag*0.10,1),' ',S);
  214.                     Writeln(Fout,S);
  215.                 end;
  216.                 S := 'END-MENU';
  217.                 Writeln(Fout,S);
  218.                 DisposeMenu(ThisMenu);
  219.             end;
  220.         end;{Of menu loop}
  221.         last := Count1Resources('DLOG');
  222.         for menuID := 1 to last do
  223.         begin
  224.             TempResHandle := Get1IndResource('DLOG', menuID);
  225.             if (TempResHandle <> Nil) and (ResError = noerr) then
  226.             Begin
  227.                 GetResInfo(TempResHandle, theactualID, theRType, S);
  228.                 ReleaseResource(TempResHandle);
  229.                 TheDialog := GetNewDialog(theactualID, nil, Pointer(-1));
  230.                 S := concat('DIALOG ',NumToStr(theactualID,0),' ',S);
  231.                 Writeln(Fout,S);
  232.                 {Write it out}
  233.                 lastitem := CountDitl(TheDialog);{Current # of items in ditl list}
  234.                 for ThisItem := 1 to lastitem do
  235.                 begin
  236.                     GetDialogItem(TheDialog, ThisItem, optType, ItemHdl, OptBox);
  237.                     if optType >= itemDisable then
  238.                     Begin
  239.                         optType := optType - itemDisable;
  240.                         TheStatFlag := 2;
  241.                     end
  242.                     else
  243.                         TheStatFlag := 1;
  244.                     case optType of
  245.                         0 : S2 := 'utm';{user item}
  246.                         4 : S2 := 'btn';{button}
  247.                         5 : S2 := 'cbx';{checkbox}
  248.                         6 : S2 := 'rbt';{radiobutton}
  249.                         7: S2 := 'cnt';{Some sort of res control probably a scroll bar}
  250.                         8 : S2 := 'stt';{stattext}
  251.                         16 : S2 := 'ett';{edit text}
  252.                         32 : S2 := 'icn';{icon}
  253.                         64 : S2 := 'pic';{pict}
  254.                         otherwise {unknows}
  255.                             S2 := '???';
  256.                     end;
  257.                     if optType in [4,5,6] then {get control name}
  258.                     Begin
  259.                         GetControlTitle(ControlRef(ItemHdl),S1);
  260.                         if TheStatFlag = 1 then {it's on}
  261.                         Begin
  262.                             TheStatFlag := 1+ GetControlValue(ControlRef(ItemHdl))*2;
  263.                             if TheStatFlag > 3 then
  264.                                 TheStatFlag := 4;
  265.                         end;
  266.                     end
  267.                     else
  268.                          if (optType = 8) or (optType = 16) then {get string name}
  269.                              GetDialogItemText(ItemHdl,S1)
  270.                          else
  271.                              S1 := '';
  272.                     S := Concat(Numtostr((ThisItem+TheStatFlag*0.10),1),' •',S2,'• ', S1);
  273.                     Writeln(Fout,S);
  274.                 end;{for ditl item loop}
  275.                 S := 'END-DIALOG';{post this too}
  276.                 Writeln(Fout,S);
  277.                 DisposeDialog(TheDialog);
  278.             end;{of error check for good restype}
  279.         end; {of dialog loop}
  280.         Writeln(Fout,'END');
  281.         Close(Fout);
  282.         CLoseResFile(FileInNum);
  283.         UseResFile(ApplResFile);
  284.     end;
  285. end;
  286. begin
  287.     MaxApplZone;                  { expand application heap to maximum }
  288.     MoreMasters;{This allocates }
  289.     MoreMasters;{This allocates }
  290.     MoreMasters;{This allocates }
  291.     MoreMasters;{This allocates }
  292.     MoreMasters;{This allocates }
  293.     MoreMasters;{This allocates }
  294.     MoreMasters;{This allocates }
  295.     MoreMasters;{This allocates }
  296.     MoreMasters;{This allocates }
  297.     MoreMasters;{This allocates }
  298.     InitGraf(@Qd.ThePort);           { initialize QuickDraw }
  299.     InitFonts;                    {     "      Font Manager }
  300.     InitWindows;                  {     "      Window Manager }
  301.     InitMenus;                    {     "      Menu Manager }
  302.     TEInit;                       {     "      Text Edit }
  303.     InitDialogs(nil);       {@TryAgain     "      Dialog Manager }
  304.     InitCursor;                   { change to arrow cursor }
  305.     ApplResFile := CurResFile;
  306.     GlobalError := GetVol(nil, OutVol);
  307.     DisToBallons;
  308. end.